(load "prelude.ss")

(define (multirember a lat)
  (letrec ((mr (lambda (lat)
                 (cond ((null? lat) '())
                       ((eq? a (car lat)) (mr (cdr lat)))
                       (else (cons (car lat)
                                   (mr (cdr lat))))))))
    (mr lat)))

(define (multirember-f test?)
  (letrec ((m-f
             (lambda (a lat)
               (cond ((null? lat) '())
                     ((test? (car lat) a) (m-f a (cdr lat)))
                     (else (cons (car lat)
                                 (m-f a (cdr lat))))))))
    m-f))
;;;;; Original implementation ;;;;;
;;
;; (define (union set1 set2)
;;   (cond ((null? set1) set2)
;;         ((member? (car set1) set2) (union (cdr set1) set2))
;;         (else (cons (car set1)
;;                     (union (cdr set1) set2)))))

(define (union set1 set2)
  (letrec ((U (lambda (set1)
                (cond ((null? set1) set2)
                      ((M? (car set1) set2)
                       (U (cdr set1)))
                      (else (cons (car set1)
                                  (U (cdr set1)))))))
           (M? (lambda (a lat)
                 (letrec
                   ((N? (lambda (lat)
                          (cond ((null? lat) #f)
                                ((eq? (car lat) a) #t)
                                (else (N? (cdr lat)))))))
                   (N? lat)))))
    (U set1)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (two-in-a-row? lat)
  (letrec ((W (lambda (a lat)
                (cond ((null? lat) #f)
                      ((eq? (car lat) a) #t)
                      (else (W (car lat) (cdr lat)))))))
    (if (null? lat)
      #f
      (W (car lat) (cdr lat)))) )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (sum-of-prefixes tup)
  (letrec
    ((S (lambda (sonssf tup)
          (cond
            ((null? tup) '())
            (else (cons (+ sonssf (car tup))
                        (S (+ sonssf (car tup))
                           (cdr tup))))))))
    (S 0 tup)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (scramble tup)
  (letrec ((P (lambda (tup rev-pre)
                (if (null? tup)
                  '()
                  (let* ((head (car tup))
                         (tail (cdr tup))
                         (new-rev (cons head rev-pre)))
                    (cons (pick head new-rev) (P tail new-rev)))))))
    (P tup '())))
